home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 1 #10 / uv1n10s1.d64 / binary saver (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  5KB  |  172 lines
  1. 10 rem binary saver v3.0
  2. 20 rem designed by brandon corfman
  3. 30 rem
  4. 40 rem * initialization *
  5. 45 if a=0 then a=1:load"dir.obj",8,1
  6. 50 poke 650,0:hx$="0123456789abcdef":s=54272:fori=0to15:pokes+24,i:next
  7. 55 poke 53281,11:poke 53280,0
  8. 60 rem * main menu *
  9. 70 print"[158][147]     [176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  10. 80 printtab(5)"[221]     [194]inary [211]aver v3.0     [221]"
  11. 90 printtab(5)"[221][196]esigned by [194]randon [195]orfman[221]"
  12. 100 printtab(5)"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  13. 110 print"[159]   [198]1 [146] - [211]ound   : ";:if sf=1 then print "[158][207]n[159]":goto130
  14. 120 print "[158][207]ff[159]"
  15. 130 print"   [198]3 [146] - [206]umbers : ";:if nf=1 then print "[158][200]ex[159]":goto150
  16. 140 print "[158][196]ecimal[159]"
  17. 150 print"   [198]5 [146] - [195]opies  : ";:if cf=1 then print "[158][205]ultiple[159]":goto170
  18. 160 print "[158][207]ne[159]"
  19. 170 print"   [198]7 [146] - [211]ave [205]emory [194]lock"
  20. 180 print"   [198]2 [146] - [211]end [196]isk [195]ommand"
  21. 190 print"   [198]8 [146] - [209]uit to [213]p[212]ime[158]"
  22. 195 print"[152] [208]ublished by [211]oftdisk [208]ublishing, [201]nc.[158]";
  23. 200 getz$:ifz$=""then200
  24. 210 ifz$="[133]"then290
  25. 220 ifz$="[137]"then1450
  26. 230 ifz$="[134]"then320
  27. 240 ifz$="[135]"then350
  28. 250 ifz$="[136]"then380
  29. 260 ifz$="[140]"then1560
  30. 270 goto200
  31. 280 rem * change sound flag *
  32. 290 sf=1-sf:ifsf=1thenprint""spc(19)"[207]n ":goto200
  33. 300 print""spc(19)"[207]ff":goto200
  34. 310 rem * change number flag *
  35. 320 nf=1-nf:ifnf=1thenprint""spc(19)"[200]ex    ":goto200
  36. 330 print""spc(19)"[196]ecimal":goto200
  37. 340 rem * change copy flag *
  38. 350 cf=1-cf:ifcf=1thenprint""spc(19)"[205]ultiple":goto200
  39. 360 print""spc(19)"[207]ne     ":goto200
  40. 370 rem * ask parameters for save *
  41. 380 print"[147][198]ilename: [159]";:l=16:gosub730:fi$=in$
  42. 385 if fi$="" then 60
  43. 390 print"[158]  [211]tarting address:      [157][157][157][157][157][159]";
  44. 400 ifnf=1thenl=4:gosub970:sa=a:goto420
  45. 410 l=5:gosub850:sa=val(in$)
  46. 420 ifsa>65534thenprinttab(9)"[150][201]nvalid starting address[145][145][145][145]":goto390
  47. 430 print"[158][197]nding address + 1:              [157][157][157][157][157][157][157][157][157][157][157][157][157][159]";
  48. 440 ifnf=1thenl=4:gosub970:ea=a:goto460
  49. 450 l=5:gosub850:ea=val(in$)
  50. 460 ifea>65535orea<=sathenprinttab(9)"[150][201]nvalid ending address[145][145][145][145]":goto430
  51. 465 printtab(9)"                      "
  52. 470 printtab(6)"[201]nsert save disk into drive"
  53. 480 print"    [211]pace [146] [159]to continue,  [198]1 [146] [159]to abort"
  54. 490 getz$:ifz$<>" "andz$<>"[133]"then490
  55. 500 ifz$="[133]"then 60
  56. 510 rem * save program *
  57. 520 print"[147]"tab(12)"[215]riting file ..."
  58. 525 printtab(11)"[207]ne moment, please"
  59. 530 sys57812fi$,8,1
  60. 540 poke193,sa-256*int(sa/256):poke194,int(sa/256)
  61. 550 poke174,ea-256*int(ea/256):poke175,int(ea/256)
  62. 560 sys62957
  63. 570 gosub1120
  64. 580 ifsc=1thensc=0:goto520
  65. 590 ifcf=1then670
  66. 600 rem * single copy option *
  67. 610 printtab(13)"[208]rogram saved!"
  68. 620 printtab(9)"[158][193]nother program? ([217]/[206])"
  69. 630 getz$:ifz$<>"y"andz$<>"n"thengosub1330:goto630
  70. 640 ifz$="y"then70 
  71. 650 goto60
  72. 660 rem * multiple copy option *
  73. 670 printtab(7)"[201]nsert disk for next copy"
  74. 680 print" [211]pace [146][159] to continue, [198]1[146] [159]to abort"
  75. 690 getz$:ifz$<>" "andz$<>"[133]"thengosub1330:goto690
  76. 700 ifz$="[133]"thensf=.:goto620
  77. 710 goto520
  78. 720 rem * string input *
  79. 730 in$=""
  80. 740 print"[166]";
  81. 750 getz$:ifz$=""then750
  82. 755 if z$=chr$(34) then 750
  83. 760 ifz$=chr$(13)thenprint"[157] ":return
  84. 770 iflen(in$)=lthen820
  85. 780 ifasc(z$)=20andlen(in$)>0thenin$=left$(in$,len(in$)-1):goto810
  86. 790 ifnot(z$>=" "andz$<="z")then750
  87. 800 in$=in$+z$
  88. 810 print"[157]"z$;:goto740
  89. 820 ifasc(z$)<>20then750
  90. 830 in$=left$(in$,len(in$)-1):goto810
  91. 840 rem * decimal input *
  92. 850 in$=""
  93. 860 print"[166]";
  94. 870 getz$:ifz$=""then870
  95. 880 ifz$=chr$(13)thenprint"[157] ":return
  96. 890 iflen(in$)=lthen940
  97. 900 ifasc(z$)=20andlen(in$)>0thenin$=left$(in$,len(in$)-1):goto930
  98. 910 ifnot(z$>="0"andz$<="9")then870
  99. 920 in$=in$+z$
  100. 930 print"[157]"z$;:goto860
  101. 940 ifasc(z$)<>20then870
  102. 950 in$=left$(in$,len(in$)-1):goto930
  103. 960 rem * hex input *
  104. 970 in$=""
  105. 980 print"[166]";
  106. 990 getz$:ifz$=""then990
  107. 1000 ifz$=chr$(13)andlen(in$)=4thenprint"[157] ":goto1080
  108. 1010 iflen(in$)=lthen1060
  109. 1020 ifasc(z$)=20andlen(in$)>0thenin$=left$(in$,len(in$)-1):goto1050
  110. 1030 ifnot(z$>="0"andz$<="9")andnot(z$>="a"andz$<="f")then990
  111. 1040 in$=in$+z$
  112. 1050 print"[157]"z$;:goto980
  113. 1060 ifasc(z$)<>20then990
  114. 1070 in$=left$(in$,len(in$)-1):goto1050
  115. 1080 a=.:fori=1to4
  116. 1090 l%=asc(mid$(in$,i,1)):l%=l%-48+(l%>64)*7:a=16*a+l%:next
  117. 1100 return
  118. 1110 rem * error checker *
  119. 1120 open1,8,15
  120. 1130 input#1,en,em$,et,es:close1
  121. 1140 ifen<>0then1160
  122. 1150 return
  123. 1160 ifen=63then1200
  124. 1170 ifen=74then1260
  125. 1180 gosub1390:print"[196]isk error!"
  126. 1190 print""en;em$;et;es:end
  127. 1200 print"[196]isk error!  [198]ile exists!"
  128. 1210 print"[210][146]eplace or [193][146]bort?"
  129. 1220 getz$:ifz$<>"r"andz$<>"a"thengosub1390:goto1220
  130. 1230 ifz$="a"then1560
  131. 1240 print"[210]eplacing file ...":open1,8,15,"s0:"+fi$:close1
  132. 1250 sc=1:return
  133. 1260 print"[196]isk error!  [196]rive not ready!"
  134. 1270 print"[210][146]etry or [193][146]bort?"
  135. 1280 getz$:ifz$<>"r"andz$<>"a"thengosub1390:goto1280
  136. 1290 ifz$="a"then1560
  137. 1300 open1,8,15,"u;":close1
  138. 1310 sc=1:return
  139. 1320 rem * bell sound *
  140. 1330 ifsf=.thenreturn
  141. 1340 pokes+1,40:pokes+5,9:pokes+6,9:pokes+4,33
  142. 1350 fori=1to40:next
  143. 1360 pokes+4,32:fori=1to400:next
  144. 1370 return
  145. 1380 rem * error sound *
  146. 1390 ifsf=.thenreturn
  147. 1400 pokes+1,10:pokes+5,9:pokes+6,9:pokes+4,33
  148. 1410 fori=1to40:next
  149. 1420 pokes+4,32:fori=1to400:next
  150. 1430 return
  151. 1440 rem * send disk command *
  152. 1450 print"[195]ommand: ";:l=29:gosub730
  153. 1460 open1,8,15
  154. 1465 if in$="" then 1490
  155. 1467 if in$="$" then print"[147][159]":sys 49152:goto 1490
  156. 1470 print#1,in$
  157. 1490 printtab(5)"[158]";
  158. 1500 get#1,a$:printa$;:if a$<>chr$(13) then 1500
  159. 1505 close 1
  160. 1510 print"       [159][208]ress  [210]eturn [146][159] to continue      ";
  161. 1520 getz$:ifz$<>chr$(13)anden=.thengosub1330:goto1520
  162. 1530 ifz$<>chr$(13)anden>0thengosub1390:goto1520 
  163. 1540 goto70 
  164. 1550 rem * end program *
  165. 1560 print"";:printtab(11)"[193]re you sure ([217]/[206])"
  166. 1570 get a$:if a$="n" then printtab(11)"[145]                  ":goto 200
  167. 1580 if a$<>"y" then 1570
  168. 1590 a=0:for i=32768 to 32775
  169. 1600 a=a+peek(i):next
  170. 1610 if a<>859 then print"[147]":end
  171. 1700 sys 8*4096+4
  172.